home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / fpkpas92.zip / SRCRTL.ZIP / RTL / DOS / FILL.PPI < prev    next >
Text File  |  1997-07-01  |  4KB  |  155 lines
  1. { FILE: FILL.PPI }
  2.  
  3. procedure floodfill(x,y:integer; border:longint);
  4.  
  5. var bordercol     : longint;
  6.     fillcol       : longint;
  7.     viewport      : viewporttype;
  8.     offset        : longint;
  9.     
  10. procedure fill(x,y:integer);
  11. var start,ende,xx : integer;
  12.     col           : longint;
  13.  
  14. begin  
  15.   xx:=x; col:=getpixel(xx,y);
  16.   if col=bordercol then exit;
  17.   while (col<>bordercol) and (xx > viewport.x1) and (col<>fillcol)
  18.     do begin
  19.       xx:=xx-1; col:=getpixel(xx,y);
  20.     end;
  21.   start:=xx+1; 
  22.  
  23.   xx:=x+1; col:=getpixel(xx,y);
  24.   while (col<>bordercol) and (xx < viewport.x2) and (col<>fillcol)
  25.     do begin
  26.       xx:=xx+1; col:=getpixel(xx,y);
  27.     end;
  28.   ende:=xx-1;
  29.  
  30.   patternline(start,ende,y);
  31.   offset:=(y * _maxy + start) shr 8;
  32.   
  33.   if (y > viewport.y1)
  34.   then begin
  35.     xx:=start;
  36.     repeat
  37.       col:=getpixel(xx,y-1);
  38.       if (col<>bordercol) and (col<>fillcol)
  39.       then begin
  40.         fill(xx,y-1);
  41.         break;
  42.       end;
  43.       xx:=xx+1;
  44.     until xx > ende;
  45.   end;
  46.  
  47.   if (y > viewport.y1) 
  48.   then begin
  49.     xx:=start;
  50.     repeat
  51.       col:=getpixel(xx,y+1);
  52.       if (col<>bordercol) and (col<>fillcol) then fill(xx,y+1);
  53.       xx:=xx+1;
  54.     until xx > ende;
  55.   end;
  56.  
  57. end;
  58.  
  59. begin
  60.   fillchar(buffermem^,buffersize,0);
  61.   if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
  62.   viewport.x2:=viewport.x2-viewport.x1;
  63.   viewport.y2:=viewport.y2-viewport.y1;
  64.   viewport.x1:=0;
  65.   viewport.y1:=0;
  66.   bordercol:=convert(border);            
  67.   if BytesPerPixel=1
  68.   then begin
  69.     bordercol:=bordercol and $FF;
  70.     fillcol:=aktfillsettings.color and $FF;
  71.   end
  72.   else begin
  73.     bordercol:=bordercol and $FFFF;
  74.     fillcol:=aktfillsettings.color and $FFFF;
  75.   end;
  76.   fill(x,y);
  77. end;
  78.  
  79. procedure GetFillSettings(var Fillinfo:Fillsettingstype);
  80. begin
  81.   _graphresult:=grOk;
  82.   if not isgraphmode then
  83.     begin
  84.       _graphresult:=grnoinitgraph;
  85.       exit;
  86.     end;
  87.   Fillinfo:=aktfillsettings;
  88. end;
  89.  
  90. procedure GetFillPattern(var FillPattern:FillPatternType);
  91. begin
  92.   _graphresult:=grOk;
  93.   if not isgraphmode then
  94.     begin
  95.       _graphresult:=grnoinitgraph;
  96.       exit;
  97.     end;
  98.   FillPattern:=aktfillpattern;
  99. end;
  100.  
  101. procedure SetFillPattern(pattern : FillPatternType;color : longint);
  102. begin
  103.   _graphresult:=grOk;
  104.   if not isgraphmode then
  105.     begin
  106.       _graphresult:=grnoinitgraph;
  107.       exit;
  108.     end;
  109.   fillpattern[12]:=pattern;
  110.   SetFillStyle(12,color);
  111. end;
  112.  
  113. procedure SetFillStyle(pattern : word ;color : longint);
  114. var i,j:Integer;
  115.     mask:Byte;
  116. begin
  117.   _graphresult:=grOk;
  118.   if not isgraphmode then
  119.     begin
  120.       _graphresult:=grnoinitgraph;
  121.       exit;
  122.     end;
  123.     { gültige Paramter ? }
  124.   if (pattern<0) or (pattern>12) then
  125.     begin
  126.       _graphresult:=grError;
  127.       exit;
  128.     end;
  129.     { Muster laden }
  130.   aktfillpattern:=fillpattern[pattern];
  131.   aktfillsettings.pattern:=pattern;
  132.   aktfillsettings.color:=convert(color);
  133.   i:=1; j:=0;
  134.   repeat
  135.     mask:=$80;
  136.       repeat
  137.         if (aktfillpattern[i] and mask) = 0
  138.           then PatternBuffer[j]:=aktbackcolor else PatternBuffer[j]:=aktfillsettings.color;
  139.            mask:=mask shr 1;
  140.            j:=j+1;
  141.       until mask=0;
  142.       i:=i+1;
  143.   until i > 8;
  144. end;
  145.  
  146. procedure GetLineSettings(var LineInfo : LineSettingsType);
  147. begin
  148.   _graphresult:=grOk;
  149.   if not isgraphmode then
  150.     begin
  151.       _graphresult:=grnoinitgraph;
  152.       exit;
  153.     end;
  154.   lineinfo:=aktlineinfo;
  155. end;